(FILECREATED "14-OCT-73 22:19:17" BUFFER)


(LISPXPRINT (QUOTE BUFFERVARS) T)
(RPAQQ BUFFERVARS ((P (CLISPDEC 'MIXED)) (FNS MONITOR ADDEVENT WAIT
GOHUNGRY REMOVEBUFFER INBUFFER ADDTOQUEUE ADDTOBUFFER BUFFERFREE CONSUME
PRODUCE DELETE INSERT REMOVEQUEUE DELETETAIL WEIGHT STATS EATSTAT
HUNGRYSTAT MAKESTAT QUEUEDSTAT INITSTATS DECIDESTAT) (VARS (MEAN 1))))
(CLISPDEC 'MIXED)
(DEFINEQ

(MONITOR
(LAMBDA (BUFLENGTH NUMBERPAIRS MAXTIME) (* DECLARATIONS: (RECORD EVENT
(TYPE PR WHEN))) (OR MAXTIME (SETQ MAXTIME 100.0)) (PROG (TIME EVENTLST1
BUFFER QUEUE HUNGRY EVENTLST) (INITSTATS) (FOR I FROM 1 TO NUMBERPAIRS
DO (ADDEVENT (QUOTE CONSUME) I (WAIT)) (ADDEVENT (QUOTE PRODUCE) I
(WAIT))) (SETQ TIME 0) LP (COND ((GREATERP TIME MAXTIME) (HELP 
"TIME EXCEEDED") (GO LP)) ((NULL EVENTLST) (HELP "NO EVENTS")) (T
(SETQ EVENTLST1 (CAR EVENTLST)) (SETQ EVENTLST (CDR EVENTLST)) (SETQ
TIME (fetch WHEN of EVENTLST1)) (APPLY* (fetch TYPE of EVENTLST1)
(fetch PR of EVENTLST1)) (GO LP))))))

(ADDEVENT
(LAMBDA (TYPE PR WHEN) (SETQ EVENTLST (INSERT (LIST TYPE PR WHEN)
EVENTLST))))

(WAIT
(LAMBDA NIL (TIMES (MINUS MEAN) (LOG (RAND 0.0 1.0)))))

(GOHUNGRY
(LAMBDA (PR) (SETQ HUNGRY (CONS PR HUNGRY))))

(REMOVEBUFFER
(LAMBDA (PR) (SETQ BUFFER (DELETE PR BUFFER)) (OR (BUFFERFREE) (HELP
"ERROR")) (COND (QUEUE (PRODUCE (REMOVEQUEUE PR))))))

(INBUFFER
(LAMBDA (PR) (MEMB PR BUFFER)))

(ADDTOQUEUE
(LAMBDA (PR) (SETQ QUEUE (NCONC1 QUEUE PR))))

(ADDTOBUFFER
(LAMBDA (PR) (SETQ BUFFER (CONS PR BUFFER)) (COND ((MEMB PR HUNGRY)
(SETQ HUNGRY (DELETE PR HUNGRY)) (CONSUME PR)))))

(BUFFERFREE
(LAMBDA NIL (LESSP (LENGTH BUFFER) BUFLENGTH)))

(CONSUME
(LAMBDA (PR) (COND ((INBUFFER PR) (EATSTAT PR) (REMOVEBUFFER PR) (
ADDEVENT (QUOTE CONSUME) PR (PLUS TIME (WAIT)))) (T (HUNGRYSTAT PR)
(GOHUNGRY PR)))))

(PRODUCE
(LAMBDA (PR) (COND ((BUFFERFREE) (MAKESTAT PR) (ADDTOBUFFER PR) (
ADDEVENT (QUOTE PRODUCE) PR (PLUS TIME (WAIT)))) (T (QUEUEDSTAT PR)
(ADDTOQUEUE PR)))))

(DELETE
(LAMBDA (X Y) (COND ((NULL Y) (HELP)) ((EQ X (CAR Y)) (CDR Y)) (T
(CONS (CAR Y) (DELETE X (CDR Y)))))))

(INSERT
(LAMBDA (EVENT LST) (* DECLARATIONS: (RECORD EVENT (TYPE PR WHEN)))
(COND ((NULL LST) (LIST EVENT)) ((GREATERP (fetch WHEN of (CAR LST))
(fetch WHEN of EVENT)) (CONS EVENT LST)) (T (CONS (CAR LST) (INSERT
EVENT (CDR LST)))))))

(REMOVEQUEUE
(LAMBDA (PR) (* DELETES AN ELEMENT FROM QUEUE, AND RETURNS WHICH ONE
WAS DELETED; OUTPUT WILLBE USED TO ALLOW THAT ELEMENT TO PRODUCE AND
INSERT IN BUFFER) (PROG (BEST (MAXWEIGHT -999999)) (COND ((EVERY (CDR
QUEUE) (FUNCTION (LAMBDA (X) (EQ X (CAR QUEUE))))) (SETQ BEST (CAR
QUEUE)) (SETQ QUEUE (CDR QUEUE)) (RETURN BEST))) (FOR TAIL ON QUEUE
BIND TEM WHEN (GREATERP (SETQ TEM (WEIGHT TAIL)) MAXWEIGHT) DO (SETQ
MAXWEIGHT TEM) (SETQ BEST TAIL)) (DECIDESTAT BEST QUEUE) (SETQ QUEUE
(DELETETAIL BEST QUEUE)) (RETURN (CAR BEST)))))

(DELETETAIL
(LAMBDA (TAIL LST) (* TAIL IS A TAIL OF LST, DELETES THE ELEMENT AT
CAR TAIL) (COND ((NULL LST) (HELP)) ((EQ TAIL LST) (CDR LST)) (T (CONS
(CAR LST) (DELETETAIL TAIL (CDR LST)))))))

(WEIGHT
(LAMBDA (TAIL) (* NOTE: QUEUE IS INCREMENTED IN THE END: I.E. (CAR
QUEUE) IS THE FIRST ELEMENT IN QUEUE) (* THIS IS THE PRIORITY FN:
FOR EXAMPLE, TO GET FIRSTCOME FIRSTSERVE, THEN THE PRIORITY IS (LENGTH
TAIL) ; TO GET LAST IN FIRST OUT, PRIORITY IS - (LENGTH TAIL) ; TO
GET ARBITRARY PRIORITY, WEIGTH MIGHT BE 1000*BUFFERNUMBER + (LENGTH
TAIL) , ETC) (LENGTH TAIL)))

(STATS
(LAMBDA NIL (MAPC (QUOTE (HUNGRYSTATS QUEUEDSTATS EATSTATS MAKESTATS
DECIDESTATS)) (FUNCTION (LAMBDA (X) (PRIN1 X T) (PRIN1 " = " T) (PRINT
(EVAL X) T))))))

(EATSTAT
(LAMBDA (PR) (SETQ EATSTATS (CONS PR EATSTATS))))

(HUNGRYSTAT
(LAMBDA (PR) (SETQ HUNGRYSTATS (CONS PR HUNGRYSTATS))))

(MAKESTAT
(LAMBDA (PR) (SETQ MAKESTATS (CONS PR MAKESTATS))))

(QUEUEDSTAT
(LAMBDA (PR) (SETQ QUEUEDSTATS (CONS PR QUEUEDSTATS))))

(INITSTATS
(LAMBDA NIL (SETQ DECIDESTATS (SETQ HUNGRYSTATS (SETQ QUEUEDSTATS
(SETQ EATSTATS (SETQ MAKESTATS NIL)))))))

(DECIDESTAT
(LAMBDA (PICKED QUEUE) (SETQ DECIDESTATS (CONS (CONS PICKED QUEUE)
DECIDESTATS))))
)
(RPAQ MEAN 1)
STOP